Descriptive Analyses: Cognitive Control and Motivated Reasoning

Descriptive Figures and Tables

Preparations

Load different dataframes

data_analysis_path <- here("01_data", "analysis", "data_analysis.RData")
data_com_path <- here("01_data", "scored", "data_questionnaire_gng_combined.RData")

load(file = data_analysis_path)
load(file = data_com_path)
data_raw <- read_csv(here("01_data", "cleaned", "data_fake_news_cleaned.csv"))
Rows: 15064 Columns: 24
── Column specification ──────────────────────────────────────────────────────────────────
Delimiter: ","
chr (16): UTC Date and Time, Participant Device, Participant Browser, Task Name, Displ...
dbl  (8): Participant Private ID, Experiment Version, Task Version, Trial Number, rt, ...

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
data_quest <- read_csv(here("01_data", "cleaned", "data_questionnaires_cleaned.csv"))
Rows: 504 Columns: 57
── Column specification ──────────────────────────────────────────────────────────────────
Delimiter: ","
chr (38): UTC Date and Time, Participant Device, Participant Browser, randomiser-evbs,...
dbl (19): Participant Private ID, Experiment Version, attention_start object-14 Quanti...

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
data <- data_analysis
data_com <- data_combined

Create new classification variables

Create variables that code high/low education, high/low crt, and high/low Go/No-Go

Education low: ISCED 0-4
Education high: ISCED 5-8

CRT low: 0, 1 correct answers
CRT high: 2, 3 correct answers

Go / No Go low: Below median commission errors reversed
Go / No Go high: Above median commission errors reversed

global_median_commission_errors <- median(data$commission_errors_r, na.rm = TRUE)

data <- data %>%
  # Education: assign high/low based on edu_group
  mutate(edu_bin = case_when(
    edu_group %in% c("ISCED 0-2", "ISCED 3-4") ~ "Low",
    edu_group %in% c("ISCED 5-8") ~ "High",
    TRUE ~ NA_character_
  )) %>%
  
  # CRT: assign high/low based on crt_correct
  mutate(crt_bin = case_when(
    crt_correct %in% c(0, 1) ~ "Low",
    crt_correct %in% c(2, 3) ~ "High",
    TRUE ~ NA_character_
  )) %>%
  
  # Go/No-Go: assign high/low based on median split
  mutate(gng_bin = if_else(
    commission_errors > global_median_commission_errors, "High", "Low"
  ))
data %>%
  select(subj_idx, edu_group, edu_bin, crt_correct, crt_bin, gng_bin) %>%
  distinct(subj_idx, .keep_all = TRUE) %>% 
  select(-subj_idx) %>%  
  mutate(across(everything(), as.factor)) %>%
  datasummary_skim()
tinytable_f968o2hresjofnwlpjek
N %
edu_group ISCED 0-2 43 8.5
ISCED 3-4 173 34.3
ISCED 5-8 286 56.7
Other 2 0.4
edu_bin High 286 56.7
Low 216 42.9
crt_correct 0 123 24.4
1 97 19.2
2 120 23.8
3 164 32.5
crt_bin High 284 56.3
Low 220 43.7
gng_bin High 9 1.8
Low 495 98.2

Create separate datasets with factual question answers (data_comion) and the truth ratings (data_rating)

data_comion <- data %>% 
  filter(Screen == "Question")

data_rating <- data %>% 
  filter(Screen == "Message")

Participant Descriptives

data_com_descriptives <- data_com %>%
  select(gender, age_group, worksit, edu_group, ideology) %>%
  mutate(
    gender = recode(gender,
                    "female" = "Female",
                    "male" = "Male",
                    "other" = "Other"),
    age_group = recode(age_group,
                       "18-24" = "18-24",
                       "25-31" = "25-31",
                       "Above 32" = "Above 32",
                       "Other" = "Other"),
    worksit = recode(worksit,
                     "At university" = "At university",
                     "Employed" = "Employed",
                     "In school" = "In school",
                     "Self-employed" = "Self-employed",
                     "Unemployed" = "Unemployed",
                     "Working in the household" = "Working in the household",
                     "__other" = "Other"),
    edu_group = recode(edu_group,
                       "ISCED 0-2" = "ISCED 0-2",
                       "ISCED 3-4" = "ISCED 3-4",
                       "ISCED 5-8" = "ISCED 5-8",
                       "Other" = "Other")
  ) %>%
  rename(
    Gender = gender,
    `Age Group` = age_group,
    `Work Situation` = worksit,
    Education = edu_group,
    Ideology = ideology
  )

datasummary_skim(data_com_descriptives, type = "categorical")
tinytable_cxzr9vqw0dvrvtxynxnr
N %
Gender Female 215 42.7
Male 284 56.3
Other 5 1.0
Age Group 18-24 167 33.1
25-31 168 33.3
Above 32 169 33.5
Work Situation At university 93 18.5
Employed 309 61.3
In school 4 0.8
Other 5 1.0
Self-employed 37 7.3
Unemployed 46 9.1
Working in the household 10 2.0
Education ISCED 0-2 43 8.5
ISCED 3-4 173 34.3
ISCED 5-8 286 56.7
Other 2 0.4
Ideology Extremely left 23 4.6
Extremely right 15 3.0
Left 159 31.5
Moderate 23 4.6
Right 91 18.1
Slightly left 83 16.5
Slightly right 110 21.8 
datasummary_skim(data_com_descriptives, type = "categorical") %>% 
  save_tt(here(table_dir, "participant_descriptives.docx"), overwrite = TRUE)

Variable descriptives

data_com %>%
  select(age_corrected, ideology_num, crt_correct, commission_errors_r
  ) %>%
  rename(
    Age = age_corrected,
    Ideology = ideology_num,
    `Cognitive Reflection` = crt_correct,
    `Inhibitory Control` = commission_errors_r
  ) %>%
  datasummary_skim(type = "numeric")
tinytable_l3c4zjwt88cxusq8rebh
Unique Missing Pct. Mean SD Min Median Max Histogram
Age 24 0 28.1 6.1 18.0 28.0 51.0
Ideology 7 0 3.7 1.7 1.0 3.0 7.0
Cognitive Reflection 4 0 1.6 1.2 0.0 2.0 3.0
Inhibitory Control 42 0 37.5 8.4 13.0 38.0 56.0 
# save it
data_com %>%
  select(age_corrected, ideology_num, crt_correct, commission_errors_r
  ) %>%
  rename(
    Age = age_corrected,
    Ideology = ideology_num,
    `Cognitive Reflection` = crt_correct,
    `Inhibitory Control` = commission_errors_r
  ) %>%
  datasummary_skim(fun_numeric = list(Mean = Mean, 
                                      SD = SD, 
                                      Min = Min, 
                                      Median = Median, 
                                      Max = Max
                                      )) %>% 
  save_tt(here(table_dir, "variable_descriptives.docx"), overwrite = TRUE)

Correlations between measured variables (questionnaires and tasks)

data_corr <- data_quest %>% 
  select(`Participant Private ID`, o_immigration:o_brain, o_discrimination, o_selfenhancement:o_gender) %>% 
  left_join(data_com, by = "Participant Private ID") %>% 
  mutate(across(o_immigration:o_gender, ~ recode(.x,
    "Strongly disagree" = 1,
    "Disagree"          = 2,
    "Neutral"           = 3,
    "Agree"             = 4,
    "Strongly agree"    = 5
  ))) %>% 
  select(age_corrected, ideology_num,  crt_correct, commission_errors_r, o_immigration:o_gender) %>%
  rename(
    "Anti-Immigration" = o_immigration,                    # Too many immigrants
    "Belief in Discrimination" = o_discrimination,         # Racial discrimination is a barrier
    "Climate Change Belief" = o_climate,                   # Earth is getting warmer due to human activity
    "Pro-Same-Sex Adoption" = o_adoption,                  # No reasons to prevent same-sex adoption
    "Pro-Harsh Punishments" = o_punishment,                # Harsher punishments reduce crime
    "Belief in Male Superiority" = o_gender,               # Men are more talented in math-related fields
    "Low Self-Evaluation" = o_selfenhancement,             # Abilities not as good as others
    "Tea with Milk" = o_teaculture,                        # Tea with milk preference
    "Brain Function Superiority" = o_brain,                # Human brain's superior function
    Age = age_corrected,
    Ideology = ideology_num,
    `Cognitive Reflection` = crt_correct,
    `Inhibitory Control` = commission_errors_r
  ) %>% 
  mutate(across(everything(), as.numeric)) 
# correlation analysis
corrs <- cor(data_corr, use = "pairwise.complete.obs")
corrs_p <- cor.mtest(data_corr, conf.level = 0.95)

# plot it 
col <- colorRampPalette(c("#4477AA", "#77AADD", "#FFFFFF", "#EE9988", "#BB4444"))
corrplot(corrs, method="color", col=col(200),  
         type="upper", order="original", 
         addCoef.col = "black", # Add coefficient of correlation
         tl.col="black", tl.srt=45, # Text label color and rotation,
         # p.mat = corrs_p$p, sig.level = 0.05, insig = "blank", 
         diag=FALSE, number.cex=0.85 
         )

# save it
png(filename = here(fig_dir, "correlation_plot.png"), width = 10, height = 10, units = "in", res = 300)

corrplot(corrs, method="color", col=col(200),  
         type="upper", order="original", 
         addCoef.col = "black", # Add coefficient of correlation
         tl.col="black", tl.srt=45, # Text label color and rotation,
         #p.mat = corrs_p$p, sig.level = 0.05, insig = "pch", 
         diag=FALSE, number.cex=0.85 
         )

dev.off()
quartz_off_screen 
                2

Number of messages

initial_rows <- nrow(data_analysis)
data_prep <- data_analysis %>% 
  filter(Screen != "Question")
filtered_rows <- initial_rows - nrow(data_prep)

filtered_rows
[1] 5389
data_full <- data_prep %>% 
  filter(question_type %in% c("political", "performance", "nonpolitical")) %>% 
  mutate(question_topic = factor(question_topic, 
                                 levels = c("climate",
                                            "gender",
                                            "immigration",
                                            "discrimination",
                                            "adoption",
                                            "punishment",
                                            "gonogo_performance", 
                                            "fakenews_performance",
                                            "teaculture",
                                            "brain"))) %>%
  droplevels()   

unique(data_full$question_topic)
 [1] adoption             climate              punishment           gender              
 [5] discrimination       gonogo_performance   immigration          teaculture          
 [9] fakenews_performance brain               
10 Levels: climate gender immigration discrimination adoption ... brain
nrow(data_full) # total number of messages
[1] 4963
nrow(data_full %>% filter(issue_motive == "Pro")) # total number of Pro messages
[1] 2037
nrow(data_full %>% filter(issue_motive == "Anti")) # total number of Anti messages
[1] 1995
nrow(data_full %>% filter(issue_motive == "Neutral")) # total number of Neutral messages
[1] 931
datasummary_crosstab(question_type ~ issue_motive, data = data_full)
tinytable_94bzrrc1ga0ut9snkbmt
question_type Anti Neutral Pro All
nonpolitical N 349 249 339 937
% row 37.2 26.6 36.2 100.0
performance N 381 254 373 1008
% row 37.8 25.2 37.0 100.0
political N 1265 428 1325 3018
% row 41.9 14.2 43.9 100.0
All N 1995 931 2037 4963
% row 40.2 18.8 41.0 100.0